00100	C**** SUBRS LINES, RDRAW, UNPACK, GRIDS, SHIFT, SHIFTX, REPACK
00200		SUBROUTINE LINES(A,B,L)
00300		COMMON /RZ/RSZ,IPLT,RJB,CENTR
00400		COMMON /FL/C,D,NQ,RZ,IXRX,XGP,RXGP
00500		DATA XGP/1200.0/,RX/1.0/
00600		COMMON/MN/M,N
00700	C  SET XGP TO 1245.0 FOR MARGIN IN XEROX COPIES
00800	23	IF(IPLT)GO TO 2
00900		M=A*RSZ
01000		N=B*RSZ
01100		IF(L.EQ.3)GO TO 1
01200		CALL AVECT(M,N)
01300		RETURN
01400	1	CALL AIVECT(M,N)
01500		RETURN
01600	CC	DIS=RSZ*1.7
01700	CC	RHT=RSZ*1.7
01800	2	IF(IXRX.EQ.0)GO TO 9
01900	CC	M=-B*RHT-BX+RXGP
02000		AX=-B*RSZ
02100		BX=RX*A*RSZ+XGP
02200	CC	N=RX*A*DIS+XGP+AX
02300		GO TO 8
02400	9	AX=A*RSZ
02500		BX=B*RSZ
02600	CC9	M=A*DIS+AX
02700	CC	N=B*RHT+BX
02800	8	X=.5
02900		IF(AX)X=-X
03000		Y=.5
03100		IF(BX)Y=-Y
03200	C  A AND B ARE FOR ROUND-OFF
03300		M=AX+X	
03400		N=BX+Y
03500		CALL PLOT(M,N,L)
03600		END
03700	
03800		SUBROUTINE RDRAW(I,JJ,IJ)
03900	C   TO X,Y INTO ONE WORD
04000		DIMENSION IJ(1)
04010		COMMON /RZ/RSZ,IPLT,RJB,CENTR
04100		COMMON/LL/L
04200		COMMON/ZN/SCLEF(400,2),DDD
04300		COMMON/MN/M,N
04400		DO 2 K=I,JJ
04500		CALL UNPACK(K,IA,IB,IJ)
04600		A=IA+RJB
04700		B=IB+CENTR
04800		IF(K.EQ.I.OR.L.GE.100000000)L=3
04900		CALL LINES(A,B,L)
05000		SCLEF(K,1)=M
05100	2	SCLEF(K,2)=N
05300		END
05400	
05500		SUBROUTINE UNPACK(K,M,N,I)
05600		COMMON/LL/L
05700	C  L IS FOR VIS. OR INVIS. LINES.
05800		DIMENSION I(1)
05900		N=I(K)
06000		L=0
06100		IF(N.LT.100000000)GO TO 2
06200		L=(N/100000000)*100000000
06300		N=N-L
06400	2	M=N/10000
06500		N=N-M*10000
06600		IF(M.GT.1000)M=1000-M
06700		IF(N.GT.1000)N=1000-N
06800		END
06900	
07000		SUBROUTINE GRIDS
07010		COMMON/RC/MCLEF(400),IST(4000)
07200		COMMON /RZ/RSZ,IPLT,RJB,CENTR
07210		EQUIVALENCE(GRID,IST(4000))
07216		DIMENSION LWRCS(9),IUPCS(8)
07232		DATA LWRCS/9,110281028,10280045,210045,211028,10281028
07243		1,210280017, 10030017,10031028/
07266		1,IUPCS/8,110281028,10280045,370045,371028,10281028
07274		1, 100041028, 40045/
07374		CALL POG2
07400		IF(GRID)GO TO 1
07510		IF(GRID.EQ.1)GO TO 2
07520		IF(GRID.EQ.3)GO TO 3
07530	C  NEXT IS UPPER CASE BOX -- GRID=2
07540		CALL RDRAW(2,IUPCS(1),IUPCS,RJB,CENTR)
07550		GO TO 1
07560	3	CALL RDRAW(2,LWRCS(1),LWRCS,RJB,CENTR)
07565	C  LOWER CASE BOX
07570		GO TO 1
07600	2	RB=32
07700		RC=35.*9./RSZ
07800		RD=78.*9./RSZ
07900		RA=2
08000	CC	IF(IPLT.LT.-1)GO TO 333
08100	C  TO SKIP LINES
08200		DO 30 L=-34,78,4
08300		RZ=L
08400		RE=RZ+CENTR
08500		IF(L.NE.-2.AND.L.NE.18.AND.L.NE.38.AND.L.NE.58)GO TO 32
08600		RF=RE+1
08700		RG=RE+3
08800		CALL LINES(RJB-1.0,RG,3)
08900		CALL LINES(RJB+1.0,RF,2)
09000		CALL LINES(RJB+19.0,RG,3)
09100		CALL LINES(RJB+21.0,RF,2)
09200	32	XA=2
09300		XB=0
09400		IF(L.EQ.14.OR.L.EQ.42)XA=20
09500		IF(L.EQ.-2.OR.L.EQ.26.OR.L.EQ.54)XB=20
09600		CALL LINES(RJB-RA-XA,RE,3)
09700		CALL LINES(RJB+RB+XA,RE,2)
09800		CALL LINES(RJB+RB+XB,RE+2.0,3)
09900	30	CALL LINES(RJB-RA-XB,RE+2.0,2)
10000		DO 31 L=-2,32,4
10100		RZ=L
10200		RE=RZ+RJB
10300		CALL LINES(RE,CENTR-RC,3)
10400		CALL LINES(RE,CENTR+RD,2)
10500		CALL LINES(RE+2.0,CENTR+RD,3)
10600	31	CALL LINES(RE+2.0,CENTR-RC,2)
10700		CALL LINES(RJB-10.,CENTR-14.,3)
10800		CALL LINES(RJB,CENTR-14.,2)
10900		CALL LINES(RJB,CENTR-28.,3)
11000		CALL LINES(RJB-10.,CENTR-28.,2)
11100	1	CALL DPYOUT(2)
11200		CALL POG1
11300		END
11400	
11500		SUBROUTINE SHIFT(M,L)
11600		DIMENSION M(1)
11700		COMMON/RC/MCLEF(400),IST(4000)
11800		EQUIVALENCE (KK,IST(2))
11900	CC	COMMON/SH/H,V,SH,SV
12000		TYPE 1
12100		KK=2
12200		ACCEPT 2,H,V,SH,SV
12300		IF(SH.EQ.0)SH=1
12400		IF(SV.EQ.0)SV=1
12600	1	FORMAT(' MOVE HORIZ, VERT., SIZE H, SIZE V'/)
12700	2	FORMAT(4F)
12800		IF(L.GT.0)GO TO 10
12900		L=-L
13000		V=999.
13300	10	DO 3 K=1,L-1
13400		CALL UNPACK(K,J,N,M)
13500		IF(V.NE.999)GO TO 4
13600	C   ROTATION      DEGREES.
13700		X=J
13800		Y=N
13900		AX=ATAN2(Y,X)*57.2957768
14000		HYP=SQRT(X**2+Y**2)
14100		ROT=AX-H
14200	C  -H, SO ROTATION IS CLOCKWISE INSTEAD OF CNTRCLKWS.
14300	C  H=DEGREES
14400		X=HYP*COSD(ROT)
14500		Y=HYP*SIND(ROT)
14600		AX=.5
14700		IF(X)AX=-AX
14800	C  AX IS FOR ROUND-OFF
14900		J=X+AX
15000		AX=.5
15100		IF(Y)AX=-AX
15200		N=Y+AX
15300		GO TO 3
15400	
15500	4	J=H+J*SH
15600		N=V+N*SV
15700	3	CALL REPACK(K,J,N,M)
15800		END
15900	
16000		SUBROUTINE REPACK(K,M,N,I)
16100		COMMON/LL/L
16200		DIMENSION I(1)
16300		M=M*10000
16400		IF(M)M=10000000-M
16500		IF(N)N=1000-N
16600		M=M+L
16700		I(K)=M+N
16800		END
16900	
17000		SUBROUTINE BUP
17010		COMMON/RC/MCLEF(400),IST(4000)
17100		IST(2)=IST(2)-1
17200		CALL HYDPOG(1)
17300		CALL ACCPOG(1)
17400		END
17500	
17600		SUBROUTINE POG2
17700		COMMON /RC/MCLEF(3400),IST(1000)
18500		CALL DPYSET(2,IST,200)
18700		CALL DPYBRT(2)
18800		END
18900	
19000		SUBROUTINE POG1
19005		CALL HYDPOG(3)
19010		CALL SETPOG(1)
19100		CALL DPYBRT(4)
19200		END